home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / lzhsrc97.arc / LZHVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-18  |  4KB  |  188 lines

  1. program lzhview;
  2. uses
  3.   dos,crt;
  4.  
  5. type
  6.  
  7. {data structure for the fileheader}
  8.  
  9.   fileheadertype = record
  10.     Headsize,Headchk:byte;
  11.     HeadID:packed array[1..5] of char;
  12.     Packsize,Origsize,Filetime:longint;
  13.     Attr:word;
  14.     filename:pathstr;
  15.   end;
  16.  
  17.  
  18. var
  19.  
  20.  
  21.   fh:fileheadertype;
  22.   fha:array[1..sizeof(fileheadertype)] of byte absolute fh;
  23.  
  24.   crc:word;   {crc value}
  25.   crcbuf:array[1..2] of byte absolute crc;
  26.   crc_table:array[0..255] of word;
  27.  
  28.   infile:file;
  29.  
  30. { this routine initialize the CRC_table }
  31. procedure  make_crc_table;
  32. var
  33.   i,index,ax:word;
  34.   carry:boolean;
  35. begin
  36.   index:=0;
  37.   repeat
  38.     ax:=index;
  39.     for i:=1 to 8 do
  40.       begin
  41.         carry:=odd(ax);
  42.         ax:=ax shr 1;
  43.         if carry then ax:=ax xor $A001;
  44.       end;
  45.     crc_table[index]:=ax;
  46.     inc(index);
  47.   until index>255;
  48. end;
  49.  
  50. {use this to calculate the CRC value of the original file}
  51. {call this function afer reading every byte from the file}
  52. procedure calccrc(data:byte);
  53. var
  54.   index:integer;
  55.  
  56. begin
  57.   crcbuf[1]:=crcbuf[1] xor data;
  58.   index:=crcbuf[1];
  59.   crc:=crc shr 8;
  60.   crc:=crc xor crc_table[index];
  61. end;
  62.  
  63.  
  64. function mksum:byte;  {calculate check sum for file header }
  65. var
  66.   i:integer;
  67.   b:byte;
  68. begin
  69.   b:=0;
  70.   for i:=3 to fh.headsize+2 do
  71.     b:=b+fha[i];
  72.   mksum:=b;
  73. end;
  74.  
  75. {format of LZH file }
  76. {
  77.  
  78.   [fileheader]
  79.   [CRC]  <--crc value(2 bytes)
  80.   [compressed data]    <--- first file
  81.  
  82.   [fileheader]
  83.   [CRC]
  84.   [compressed data]    <--- second file
  85.       .
  86.       .
  87.       .
  88.   [fileheader]         <--- last file
  89.   [CRC]
  90.   [compressed data]
  91.  
  92.   0                    <--- a zero indicates end of LZH archive
  93.  
  94.  
  95.  
  96. fileheader:
  97.   Headsize = size of file header in bytes
  98.   Headchk  = check sum of fileheader, obtained using mksum
  99.   HeadID   = 5 characters,
  100.              either '-lh0-  (file is not compressed, simply stored)
  101.              or     '-lh1-' (file is compressed)
  102.  
  103.   Packsize = compressed size of file
  104.  
  105.   Origsize = original size of file
  106.   Filetime = time/date of file;
  107.   Attr     = attribue of file;
  108.   filename = the filename,a string in PASCAL;
  109.  
  110.  
  111.  
  112.   For the source for the compression routine, see the file
  113.   LZHSRC10.LZH, a C source file implementing the LZH routine, but does
  114.   not include information on fileheader and CRC-value.
  115.   Use the function make_crc_table to set up the crc table before
  116.   every compression. and use the calcCRC(byte) to work out the crc value.
  117.  
  118.   Unfortunately, the source code is in C, you may have to convert this
  119.   program to C as well.
  120.   Using Turbo C, is faster than Turbo Pascal in execution speed, after
  121.   applying the various optimizations.
  122.   I have also converted the LZH routine to PASCAL, unfortunately, I have
  123.   misplaced it somewhere. I can get upload it to you when I found it.
  124.  
  125.   Note: A routine in pure Turbo Pascal is about 4 times as slow as
  126.         LHarc. There is also the source code for LHarc if you're interested.
  127.         It's written in assembler and interfaced to C.
  128.  
  129.  
  130.  
  131.  
  132. }
  133.  
  134. procedure viewlzh;
  135. label
  136.   done;
  137. var
  138.   l1,l2,oldfilepos:longint;
  139.   count:integer;
  140.   numread,i:word;
  141.   s1:string[50];
  142.   s2:string[20];
  143.  
  144. begin
  145.   assign(infile,paramstr(1));
  146.   reset(infile,1);
  147.   gotoxy(3,wherey);
  148.   writeln('Filename      Original  Packsize  Ratio');
  149.  
  150.   oldfilepos:=0;
  151.   count:=1;
  152.   repeat
  153.     seek(infile,oldfilepos);
  154.     blockread(infile,fha,sizeof(fileheadertype),numread);
  155.     oldfilepos:=oldfilepos+fh.headsize+2+fh.packsize;
  156.    i:=mksum;
  157.    if fh.headsize<>0 then
  158.      begin
  159.        if i<>fh.headchk then
  160.          begin
  161.            writeln('Checksum error in file');
  162.            goto done;
  163.          end;
  164.        gotoxy(3,wherey);
  165.        write(fh.filename);
  166.        gotoxy(15,wherey);
  167.        write(fh.origsize:10);
  168.        write(fh.packsize:10);
  169.        l1:=fh.packsize;
  170.        l2:=fh.origsize;
  171.        if l2>2147400 then
  172.          begin
  173.            l2:=l2 div 1000;
  174.          end
  175.        else l1:=l1*1000;
  176.        l1:=l1 div l2;
  177.        writeln(l1 div 10:4,'.',l1 mod 10:1,'%');
  178.      end;
  179.   until   (fh.headsize=0);
  180.  
  181.  
  182. done:
  183.   close(infile);
  184. end;
  185.  
  186. begin
  187.   viewlzh;
  188. end.